Aminet 33

home *** CD-ROM | disk | FTP | other *** search

/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / dev / basic / AmosBlitz_src.lha / Sourcecodes / Reversi.asc < prev next >

Wrap

Text File | 1996-06-13 | 11.6 KB | 566 lines

Screen Open 0,320,256,16,Lowres : Curs Off : Flash Off : Colour 1,$0 Double Buffer Led Off Dim BD(16,16) MAIN: BD(4,3)=1 : BD(3,4)=1 : BD(3,3)=2 : BD(4,4)=2 Unpack 4 To 0 Screen Display 0,,300,, Music 1 : Mvolume 63 Set Rainbow 0,0,300,"","","(18,-1,18)" Rainbow 0,40,40,300 Channel 1 To Rainbow 0 : Amal 1,"M 0,256,50" For Y=300 To 44 Step -4 Wait Vbl Screen Display 0,,Y,, Next Y LL: Reserve Zone 4 Set Zone 1,59,108 To 241,122 Set Zone 2,59,132 To 241,146 Set Zone 3,49,157 To 251,172 Limit Mouse : Show L: While Mouse Key<>1 MZ=Mouse Zone Wend If MZ=0 Then Goto L If MZ=1 Then NUMPLAYERS=1 If MZ=2 Then NUMPLAYERS=2 If MZ=3 Then NUMPLAYERS=0 Fade 3 : Amal On 1 : Colour Back 0 : Reserve Zone 0 For V=63 To 0 Step -1 : Mvolume V : Wait 1 : Next : Rainbow Del 0 Gosub INITILAISE Gosub DRW_BOARD LP: Gosub GT_PLYR_MVE Gosub CHKMVE Goto LP INITILAISE: Screen Close 0 Unpack 5 To 1 : Screen Hide 1 : Randomize Timer Set Rainbow 0,7,30,"","","(2,1,1)" : Rainbow 0,0,240,30 Set Rainbow 1,7,30,"","(2,1,1)","" : Rainbow 1,0,270,30 Curs Off : Screen Open 0,640,256,16,Hires Screen Copy 1 To 0 Screen 0 : Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 : Flash Off SX=16 : SY=-2 : Limit Mouse 128,42 To 327,241 WHITES=0 : BLACKS=0 : Double Buffer : Bob Update Off Screen Swap : Wait Vbl Return DRW_BOARD: Fade 5 To 1 : Wait 50 Flash 15,"(000,4)(0d0,4)" For MY=3 To 4 For MX=3 To 4 CP=BD(MX,MY) Gosub DRWPIECE Next MX Next MY CP=1 : OP=2 Return GT_PLYR_MVE: Ink 3,15 : Bar 442,105 To 570,113 Gosub TESTKEY Gosub FULLBOARD If PASSED=2 Then Goto FINISH : Rem end of game Gosub CANYOUGO If PASS=1 Gosub YOUCANTGO Gosub CHPLYR Goto GT_PLYR_MVE End If If CP=1 Ink 0,15 : Text 442,111,"Weiß ist dran" Else Ink 0,15 : Text 442,111,"Schwarz ist dran" End If If CP=1 and NUMPLAYERS>0 or(CP=2 and NUMPLAYERS=2) Show While Mouse Key<>1 : Gosub TESTKEY : Wend MX=X Screen(X Mouse)-SX : MY=Y Screen(Y Mouse)-SY MX=(MX/50) : MY=(MY/25) Else Gosub TESTKEY Gosub COMPMOVE End If If BD(MX,MY)>0 Bell : Ink 3,15 : Bar 442,105 To 595,113 Ink 0,15 : Text 442,111,"Unmöglicher Zug" : Wait 25 Goto GT_PLYR_MVE End If Return CHKMVE: Gosub TESTKEY MOVED=0 Gosub CHU : Gosub CHD : Gosub CHL : Gosub CHR Gosub CHLU : Gosub CHLD : Gosub CHRD : Gosub CHRU If MOVED>0 Gosub CHPLYR Dec PASSED : Else Bell : Ink 3,15 Bar 442,105 To 595,113 Ink 0,15 : Text 442,111,"Unmöglicher Zug" : Wait 25 End If If PASSED<0 Then PASSED=0 Return CHU: POSS=0 : UP=1 If MY<2 Then Return If BD(MX,MY-1)<>OP Then Return For C=1 To MY If BD(MX,MY-C)=0 Then POSS=0 : Return If BD(MX,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX,MY-C)=CP and POSS=1 Then POSS=2 : Goto MVU Next Return MVU: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX,MY-UP)=OP BD(MX,MY-UP)=CP BNUM=(8*MX)+MY-UP : BX=SX+(MX*50)-13 : BY=SY+((MY-UP)*25)+3 Gosub TURNCOLOUR Inc UP Wend Return CHD: POSS=0 : DN=1 If MY>7 Then Return If BD(MX,MY+1)<>OP Then Return For C=1 To 8-MY If BD(MX,MY+C)=0 Then POSS=0 : Return If BD(MX,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX,MY+C)=CP and POSS=1 Then POSS=2 : Goto MVD Next Return MVD: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX,MY+DN)=OP BD(MX,MY+DN)=CP BNUM=(8*MX)+MY+DN : BX=SX+(MX*50)-13 : BY=SY+((MY+DN)*25)+3 Gosub TURNCOLOUR Inc DN Wend Return CHL: POSS=0 : LF=1 If MX<2 Then Return If BD(MX-1,MY)=0 or BD(MX-1,MY)=CP Then Return For C=1 To MX If BD(MX-C,MY)=0 Then POSS=0 : Return If BD(MX-C,MY)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY)=CP and POSS=1 Then POSS=2 : Goto MVL Next Return MVL: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX-LF,MY)=OP BD(MX-LF,MY)=CP BNUM=8*(MX-LF)+MY : BX=SX+((MX-LF)*50)-13 : BY=SY+(MY*25)+3 Gosub TURNCOLOUR Inc LF Wend Return CHR: POSS=0 : RT=1 If MX>7 Then Return If BD(MX+1,MY)<>OP Then Return For C=1 To 8-MX If BD(MX+C,MY)=0 Then POSS=0 : Return If BD(MX+C,MY)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY)=CP and POSS=1 Then POSS=2 : Goto MVR Next Return MVR: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX+RT,MY)=OP BD(MX+RT,MY)=CP BNUM=(8*(MX+RT))+MY : BX=SX+((MX+RT)*50)-13 : BY=SY+(MY*25)+3 Gosub TURNCOLOUR Inc RT Wend Return CHLU: POSS=0 : LU=1 If MY<1 or MX<1 Then Return If BD(MX-1,MY-1)<>OP Then Return For C=1 To 9 If MY-C<0 or MX-C<0 Then Return If BD(MX-C,MY-C)=0 Then POSS=0 : Return If BD(MX-C,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY-C)=CP and POSS=1 Then POSS=2 : Goto MVLU Next Return MVLU: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX-LU,MY-LU)=OP BD(MX-LU,MY-LU)=CP BNUM=(8*(MX-LU))+MY-LU : BX=SX+((MX-LU)*50)-13 : BY=SY+((MY-LU)*25)+3 Gosub TURNCOLOUR Inc LU Wend Return CHLD: POSS=0 : LD=1 If MY=7 or MX=0 Then Return If BD(MX-1,MY+1)<>OP Then Return For C=1 To 9 If MY+C>7 or MX-C<0 Then Return If BD(MX-C,MY+C)=0 Then POSS=0 : Return If BD(MX-C,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY+C)=CP and POSS=1 Then POSS=2 : Goto MVLD Next Return ' MVLD: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX-LD,MY+LD)=OP BD(MX-LD,MY+LD)=CP BNUM=(8*(MX-LD))+MY+LD : BX=SX+((MX-LD)*50)-13 : BY=SY+((MY+LD)*25)+3 Gosub TURNCOLOUR Inc LD Wend Return CHRD: POSS=0 : RD=1 If MX=7 or MY=7 Then Return If BD(MX+1,MY+1)<>OP Then Return For C=1 To 9 If MY+C>7 or MX+C>7 Then Return If BD(MX+C,MY+C)=0 Then POSS=0 : Return If BD(MX+C,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY+C)=CP and POSS=1 Then POSS=2 : Goto MVRD Next Return MVRD: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX+RD,MY+RD)=OP BD(MX+RD,MY+RD)=CP BNUM=(8*(MX+RD))+MY+RD : BX=SX+((MX+RD)*50)-13 : BY=SY+((MY+RD)*25)+3 Gosub TURNCOLOUR Inc RD Wend Return CHRU: POSS=0 : RU=1 If MX=7 or MY=0 Then Return If BD(MX+1,MY-1)<>OP Then Return For C=1 To 9 If MY-C<0 or MX+C>7 Then Return If BD(MX+C,MY-C)=0 Then POSS=0 : Return If BD(MX+C,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY-C)=CP and POSS=1 Then POSS=2 : Goto MVRU Next Return MVRU: BD(MX,MY)=CP If MOVED=0 Then Gosub DRWPIECE MOVED=1 While BD(MX+RU,MY-RU)=OP BD(MX+RU,MY-RU)=CP BNUM=(8*(MX+RU))+MY-RU : BX=SX+((MX+RU)*50)-13 : BY=SY+((MY-RU)*25)+3 Gosub TURNCOLOUR Inc RU Wend Return CHPLYR: Swap OP,CP Return DRWPIECE: BX=SX+(MX*50)-13 BY=SY+(MY*25)+3 If CP=1 Inc WHITES For A=6 To 1 Step -1 Screen Copy 1,BX,BY,BX+44,BY+22 To 0,BX,BY Paste Bob BX,BY,A Screen Copy Logic,BX,BY-1,BX+45,BY+23 To Physic,BX,BY-1 Next : Shoot Else Inc BLACKS For A=6 To 11 Screen Copy 1,BX,BY,BX+44,BY+22 To 0,BX,BY Paste Bob BX,BY,A Screen Copy Logic,BX,BY-1,BX+45,BY+23 To Physic,BX,BY-1 Next : Shoot End If Gosub SHSCORE Return ' TURNCOLOUR: If CP=2 Inc BLACKS : Dec WHITES For B=1 To 11 Screen Copy 1,BX,BY,BX+44,BY+22 To 0,BX,BY Paste Bob BX,BY,B Screen Copy Logic,BX-1,BY-1,BX+45,BY+23 To Physic,BX-1,BY-1 Next : Shoot Else Inc WHITES : Dec BLACKS For B=11 To 1 Step -1 Screen Copy 1,BX,BY,BX+44,BY+22 To 0,BX,BY Paste Bob BX,BY,B Screen Copy Logic,BX-1,BY-1,BX+45,BY+23 To Physic,BX-1,BY-1 Next : Shoot End If Gosub SHSCORE Return SHSCORE: Ink 3,15 Bar 556,53 To 580,63 Bar 556,75 To 580,86 Gr Writing 0 Ink 0,3 Text 557,63,Str$(BLACKS) Text 557,86,Str$(WHITES) Screen Copy Logic To Physic Return COMPMOVE: BESTX=0 : BESTY=0 : BEST=0 MOVED=0 : CORNER=0 : GOFORIT=0 For MX=0 To 8 Step 7 For MY=0 To 8 Step 7 MOVED=0 Gosub HU : Gosub HD : Gosub HL : Gosub HR Gosub HLU : Gosub HLD : Gosub HRD : Gosub HRU If MOVED>1 Then Return If MOVED>0 and Rnd(1)=0 Then Return Next MY Next MX For MX=0 To 8 Step 7 For MY=0 To 7 MOVED=0 Gosub HU : Gosub HD : Gosub HL : Gosub HR Gosub HLU : Gosub HLD : Gosub HRD : Gosub HRU If MOVED>3 Then Return Next MY Next MX For MX=0 To 7 For MY=0 To 7 MOVED=0 Gosub HU : Gosub HD : Gosub HL : Gosub HR Gosub HLU : Gosub HLD : Gosub HRD : Gosub HRU If MOVED>BEST Then BEST=MOVED : BESTX=MX : BESTY=MY Next MY Next MX MX=BESTX : MY=BESTY Return CANYOUGO: PASS=1 MOVED=0 For MX=0 To 7 For MY=0 To 7 Gosub HU : Gosub HD : Gosub HL : Gosub HR Gosub HLU : Gosub HLD : Gosub HRD : Gosub HRU If MOVED>0 Then PASS=0 Next MY Next MX Return YOUCANTGO: Ink 3,15 : Bell Bar 442,105 To 570,113 Ink 0,15 Text 442,111,"Kein möglicher Zug" Inc PASSED Return HU: POSS=0 : UP=1 If BD(MX,MY)>0 Then Return If MY<2 Then Return If BD(MX,MY-1)<>OP Then Return For C=1 To MY If BD(MX,MY-C)=0 Then POSS=0 : Return If BD(MX,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX,MY-C)=CP and POSS=1 Then POSS=2 : Goto VU Next Return ' VU: While BD(MX,MY-UP)=OP Inc UP Inc MOVED Wend Return ' ' HD: If BD(MX,MY)>0 Then Return POSS=0 : DN=1 If MY>7 Then Return If BD(MX,MY+1)<>OP Then Return For C=1 To 8-MY If BD(MX,MY+C)=0 Then POSS=0 : Return If BD(MX,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX,MY+C)=CP and POSS=1 Then POSS=2 : Goto VD Next Return ' VD: While BD(MX,MY+DN)=OP Inc DN Inc MOVED Wend Return ' HL: If BD(MX,MY)>0 Then Return POSS=0 : LF=1 If MX<2 Then Return If BD(MX-1,MY)=0 or BD(MX-1,MY)=CP Then Return For C=1 To MX If BD(MX-C,MY)=0 Then POSS=0 : Return If BD(MX-C,MY)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY)=CP and POSS=1 Then POSS=2 : Goto VL Next Return ' VL: While BD(MX-LF,MY)=OP Inc LF Inc MOVED Wend Return ' HR: If BD(MX,MY)>0 Then Return POSS=0 : RT=1 If MX>7 Then Return If BD(MX+1,MY)<>OP Then Return For C=1 To 8-MX If BD(MX+C,MY)=0 Then POSS=0 : Return If BD(MX+C,MY)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY)=CP and POSS=1 Then POSS=2 : Goto VR Next Return ' VR: While BD(MX+RT,MY)=OP Inc RT Inc MOVED Wend Return ' HLU: If BD(MX,MY)>0 Then Return POSS=0 : LU=1 If MY<1 or MX<1 Then Return If BD(MX-1,MY-1)<>OP Then Return For C=1 To 9 If MY-C<0 or MX-C<0 Then Return If BD(MX-C,MY-C)=0 Then POSS=0 : Return If BD(MX-C,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY-C)=CP and POSS=1 Then POSS=2 : Goto VLU Next Return ' VLU: While BD(MX-LU,MY-LU)=OP Inc LU Inc MOVED Wend Return ' HLD: If BD(MX,MY)>0 Then Return POSS=0 : LD=1 If MY=7 or MX=0 Then Return If BD(MX-1,MY+1)<>OP Then Return For C=1 To 9 If MY+C>7 or MX-C<0 Then Return If BD(MX-C,MY+C)=0 Then POSS=0 : Return If BD(MX-C,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX-C,MY+C)=CP and POSS=1 Then POSS=2 : Goto VLD Next Return ' VLD: While BD(MX-LD,MY+LD)=OP Inc LD Inc MOVED Wend Return ' HRD: If BD(MX,MY)>0 Then Return POSS=0 : RD=1 If MX=7 or MY=7 Then Return If BD(MX+1,MY+1)<>OP Then Return For C=1 To 9 If MY+C>7 or MX+C>7 Then Return If BD(MX+C,MY+C)=0 Then POSS=0 : Return If BD(MX+C,MY+C)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY+C)=CP and POSS=1 Then POSS=2 : Goto VRD Next Return ' VRD: While BD(MX+RD,MY+RD)=OP Inc RD Inc MOVED Wend Return ' HRU: If BD(MX,MY)>0 Then Return POSS=0 : RU=1 If MX=7 or MY=0 Then Return If BD(MX+1,MY-1)<>OP Then Return For C=1 To 9 If MY-C<0 or MX+C>7 Then Return If BD(MX+C,MY-C)=0 Then POSS=0 : Return If BD(MX+C,MY-C)=OP and POSS<2 Then POSS=1 If BD(MX+C,MY-C)=CP and POSS=1 Then POSS=2 : Goto VRU Next Return ' VRU: While BD(MX+RU,MY-RU)=OP Inc RU Inc MOVED Wend Return FINISH: Fade 5 : Wait 75 Screen 1 : Screen Show 1 : Screen To Front 1 Paper 0 : Pen 1 : Curs Off : Cls 0 : Fade 5 To 1 : Wait 50 Locate 10,10 : Print "Weiß: ";WHITES Locate 10,12 : Print "Schwarz: ";BLACKS : Print : Print : Print If WHITES>BLACKS Then Print "Weiß hat gewonnen!" If BLACKS>WHITES Then Print "Schwarz hat gewonnen!" If WHITES=BLACKS Then Print "Unentschieden!" Locate 1,20 : Centre "Drück eine Maustaste" Rainbow Del While Mouse Key=0 : Wend For XX=0 To 7 : For YY=0 To 7 : BD(XX,YY)=0 : Next YY : Next XX FULLBOARD=1 : PASSED=0 : MOVED=0 : POSS=0 : MX=0 : MY=0 : BX=0 : BY=0 : CP=1 : OP=2 Fade 2 : Wait 30 : Screen Close 1 : Goto MAIN FULLBOARD: FULLBOARD=1 For XX=0 To 7 For YY=0 To 7 If BD(XX,YY)=0 Then FULLBOARD=0 Next YY Next XX If FULLBOARD=1 Then PASSED=2 Return TESTKEY: I$=Inkey$ : If I$="Q" Then Bell : Goto FINISH If I$="q" Then Bell : Goto FINISH Return